home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / qwik5x.zip / QINITEST.PAS < prev    next >
Pascal/Delphi Source File  |  1988-12-19  |  8KB  |  274 lines

  1. { =========================================================================== }
  2. { Qinitest.pas - tests your system configuration            ver 5.x, 12-20-88 }
  3. { =========================================================================== }
  4.  
  5. { Add "$" to include IBM's submodel ID detection: }
  6. { Define AddSubModelID }
  7. {^ add "$" here }
  8.  
  9. program QinitTest;
  10.  
  11. uses
  12.   Crt, Qwik, Strs;
  13.  
  14. type
  15.   Str9  = string[ 9];
  16.   Str33 = string[33];
  17.  
  18. var
  19.   NewMode,OldVideoMode: byte;
  20.   Strng:                string;
  21.   Ch:                   char;
  22.  
  23. const
  24.   CursorDelay = 1500;
  25.  
  26. { Since Zenith doesn't have snow on any CGAs, turn off snow checking }
  27. procedure CheckZenith;
  28. var  ZdsRom: array[1..8] of char absolute $F000:$800C;
  29. begin
  30.   if Qsnow and (ZdsRom='ZDS CORP') then
  31.     begin
  32.       Qsnow    := false;
  33.       CardSnow := false;
  34.     end;
  35. end;
  36.  
  37. procedure ClearScr;
  38. begin
  39.   Qfill (1,1,CRTrows,CRTcols,TextAttr,' ');
  40. end;
  41.  
  42. procedure InitScreen;
  43. begin
  44.   CheckZenith;
  45.   CheckSnow := Qsnow;
  46.   TextAttr  := Yellow;
  47.   ClearScr;
  48. end;
  49.  
  50. { -- Converts any number into a Binary character string -- }
  51. function DecToBin (Number: longint; Bits: byte): str33;
  52. const
  53.   D2B: array[0..1] of char = '01';
  54. var
  55.   BinStr: Str33;
  56.   Bit:    byte;
  57. begin
  58.   BinStr:='b';
  59.   for Bit:=0 to pred(Bits) do
  60.     BinStr:=D2B[(Number shr Bit) and 1] + BinStr;
  61.   DecToBin:=BinStr;
  62. end;
  63.  
  64. { -- Converts any number into a Hex character string -- }
  65. function DecToHex (Number: longint; HexChars: byte): str9;
  66. const
  67.   D2H: array[0..$F] of char = '0123456789ABCDEF';
  68. var
  69.   HexStr:       Str9;
  70.   HexChar,Bits: byte;
  71. begin
  72.   HexStr:='';
  73.   for HexChar:=0 to pred(HexChars) do
  74.     begin
  75.       Bits:=HexChar shl 2;
  76.       HexStr:=D2H[(Number shr Bits) and $F] + HexStr;
  77.     end;
  78.   DecToHex:='$' + HexStr;
  79. end;
  80.  
  81. procedure DisplayDev (DD: byte);
  82. begin
  83.   case DD of
  84.     $00: Strng:='No display';
  85.     $01: Strng:='MDA with 5151 monochrome';
  86.     $02: Strng:='CGA with 5153/4 color';
  87.     $04: Strng:='EGA with 5153/4 color';
  88.     $05: Strng:='EGA with 5151 monochrome';
  89.     $06: Strng:='PGC with 5175 color';
  90.     $07: Strng:='VGA with analog monochrome';
  91.     $08: Strng:='VGA with analog color';
  92.     $0B: Strng:='MCGA with analog monochrome';
  93.     $0C: Strng:='MCGA with analog color';
  94.   else Strng:='Reserved';
  95.   end; { case }
  96. end;
  97.  
  98. function StrTF (TF: boolean): Str9;
  99. begin
  100.   if TF then
  101.        StrTF:='True'
  102.   else StrTF:='False';
  103. end;
  104.  
  105. procedure DisplaySetCursor (Msg: string; Cursor: word);
  106. begin
  107.   SetCursor (Cursor);
  108.   QwriteEos (SameAttr,Msg+DecToHex(Cursor,4));
  109.   GotoEos;
  110.   delay (CursorDelay);
  111.   EosLn;
  112. end;
  113.  
  114. procedure DisplayModCursor (Msg: string; Cursor: word);
  115. begin
  116.   ModCursor (Cursor);
  117.   QwriteEos (SameAttr,Msg+DecToHex(Cursor,4)+' '+DecToHex(GetCursor,4));
  118.   GotoEos;
  119.   delay (CursorDelay);
  120.   EosLn;
  121. end;
  122.  
  123. procedure PromptKey;
  124. begin
  125.   Qwrite (CRTrows,1,SameAttr,'Press any key...');
  126.   GotoEos;
  127.   repeat
  128.     Ch:=ReadKey;
  129.   until not KeyPressed;
  130. end;
  131.  
  132. begin
  133.   InitScreen;
  134.   OldVideoMode := QVideoMode;
  135.   Qwrite (1,1,-1,'Which text mode [0,1,2,3,7] ? ');
  136.   GotoEos;
  137.   repeat
  138.     Ch:=readkey;
  139.   until Ch in ['0'..'3','7'];
  140.   NewMode := ord(Ch)-ord('0');
  141.   if NewMode<>OldVideoMode then
  142.     begin
  143.       TextMode (NewMode+hi(LastMode));
  144.       Qinit;
  145.     end;
  146.   InitScreen;
  147.   case CpuID of
  148.     Cpu8086:  Strng:='Intel 8086/88';
  149.     Cpu80186: Strng:='Intel 80186/188';
  150.     Cpu80286: Strng:='Intel 80286';
  151.     Cpu80386: Strng:='Intel 80386';
  152.   end;
  153.   Qwrite ( 1,1,SameAttr,'CPU ident         = '+Strng);
  154.  
  155.   {$IfDef AddSubModelID }
  156.   GetSubModelID;               { Check docs before using this procedure. }
  157.   {$EndIf }
  158.   case SystemID of
  159.     $FF: Strng:='IBM PC';
  160.     $FE: Strng:='IBM PC XT';
  161.     $FD: Strng:='IBM PCjr';
  162.     $FC: case SubModelID of
  163.            $00: Strng:='IBM PC AT (6 MHz)';
  164.            $01: Strng:='IBM PC AT (8 MHz)';
  165.            $02: Strng:='IBM PC XT (286)';
  166.            $04: Strng:='IBM PS/2 Model 50';
  167.            $05: Strng:='IBM PS/2 Model 60';
  168.          else   Strng:='IBM PS/2 VGA type';
  169.          end;
  170.     $FB: Strng:='IBM PC XT (256/640)';
  171.     $FA: case SubModelID of
  172.            $00: Strng:='IBM PS/2 Model 30';
  173.            $01: Strng:='IBM PS/2 Model 25';
  174.          else   Strng:='IBM PS/2 MCGA type';
  175.          end;
  176.     $F9: Strng:='IBM PC convertible';
  177.     $F8: case SubModelID of
  178.            $00: Strng:='IBM PS/2 Model 80 (16 MHz)';
  179.            $01: Strng:='IBM PS/2 Model 80 (20 MHz)';
  180.            $09: Strng:='IBM PS/2 Model 70 (16 MHz)';
  181.          else   Strng:='IBM PS/2 Model 70/80 type';
  182.          end;
  183.   else Strng:='Unknown, not an IBM';
  184.   end;  { case }
  185.  
  186.   Qwrite ( 2,1,SameAttr,'System ID         = '+DecToHex(SystemID,2));
  187.   {$IfDef AddSubModelID }
  188.   Qwrite ( 3,1,SameAttr,'SubModel ID       = '+StrL (SubModelID));
  189.   {$Else }
  190.   Qwrite ( 3,1,SameAttr,'SubModel ID       = ??');
  191.   {$EndIf }
  192.   Qwrite ( 4,3,SameAttr, Strng);
  193.   Qwrite ( 5,1,SameAttr,'Have PS/2 video   = '+StrTF (HavePS2));
  194.   Qwrite ( 6,1,SameAttr,'IBM 3270 PC       = '+StrTF (Have3270));
  195.   Qwrite ( 7,1,SameAttr,'Prior video mode  = '+StrL  (OldVideoMode));
  196.   Qwrite ( 8,1,SameAttr,'Video mode now    = '+StrL  (QvideoMode));
  197.   Qwrite ( 9,1,SameAttr,'Wait-for-retrace  = '+StrTF (Qsnow));
  198.   Qwrite (10,1,SameAttr,'Max page #        = '+StrL  (MaxPage));
  199.  
  200.   if Have3270 then
  201.     begin
  202.       Qwrite (11,1,SameAttr,
  203.               'Disp Dev 3270     = '+DecToHex(ActiveDispDev3270,2));
  204.       case ActiveDispDev3270 of
  205.         $00: Strng:='5151 or 5272 display and adapter';
  206.         $01: Strng:='3295 display and adapter';
  207.         $02: Strng:='5151 or 5272, adapter, XGA graphics';
  208.         $03: Strng:='5279 display, 3270 PC G adapter';
  209.         $04: Strng:='5379 C01 display, 3270 PC GX adapter';
  210.         $05: Strng:='5379 M01 display, 3270 PC GX adapter';
  211.         $FF: Strng:='Unknown, not a 3270 PC';
  212.       else Strng:='Reserved';
  213.       end;
  214.       Qwrite (12,3,SameAttr,Strng);
  215.     end
  216.   else
  217.     begin
  218.       DisplayDev (ActiveDispDev);
  219.       Qwrite (11,1,SameAttr,'Active Disp Dev   = '+DecToHex(ActiveDispDev,2));
  220.       Qwrite (12,3,SameAttr,Strng);
  221.  
  222.       if SystemID=$F9 then    { PC convertible }
  223.         Qwrite (13,1,SameAttr,
  224.                 'Alt Disp Dev PC Conv = '+DecToHex(AltDispDevPCC,4))
  225.       else
  226.         begin
  227.           DisplayDev (AltDispDev);
  228.           Qwrite (13,1,SameAttr,'Alt Disp Dev      = '+DecToHex(AltDispDev,2));
  229.           Qwrite (14,3,SameAttr,Strng);
  230.         end;
  231.  
  232.       Qwrite (15,1,SameAttr,'Hercules model    = '+StrL(HercModel));
  233.       case HercModel of
  234.         0: Strng:='No Hercules card';
  235.         1: Strng:='Hercules Graphics Card';
  236.         2: Strng:='Hercules Graphics Card Plus';
  237.         3: Strng:='Hercules InColor Card';
  238.       end;
  239.       Qwrite (16,3,SameAttr,Strng);
  240.     end;
  241.  
  242.   Qwrite (17,1,SameAttr,'CRT rows          = '+StrL(CRTrows));
  243.   Qwrite (18,1,SameAttr,'CRT columns       = '+StrL(CRTcols));
  244.   Qwrite (19,1,SameAttr,'Cursor start      = '+DecToHex(hi(CursorInitial),2));
  245.   Qwrite (20,1,SameAttr,'Cursor end        = '+DecToHex(lo(CursorInitial),2));
  246.   if (ActiveDispDev>=EgaColor) and (ActiveDispDev<=McgaColor) then
  247.     begin
  248.       Qwrite (21,1,SameAttr,'EGA rows          = '+StrL(EgaRows));
  249.       Qwrite (22,1,SameAttr,'EGA FontSize      = '+StrL(EgaFontSize));
  250.       Qwrite (23,1,SameAttr,'EGA Info          = '+DecToBin(EgaInfo,8));
  251.       Qwrite (24,1,SameAttr,'EGA Switches      = '+DecToBin(EgaSwitches,8));
  252.     end;
  253.   PromptKey;
  254.   ClearScr;
  255.   QwriteC (1,1,CRTcols,SameAttr,'Cursor Modes Test:');
  256.   Qwrite (3,1,SameAttr,'SET              MODE');
  257.   Qwrite (4,1,SameAttr,'-------------   -----');
  258.   EosLn;
  259.   DisplaySetCursor ('Initial       = ',CursorInitial);
  260.   DisplaySetCursor ('Underline     = ',CursorUnderline);
  261.   DisplaySetCursor ('Half-block    = ',CursorHalfBlock);
  262.   DisplaySetCursor ('Block         = ',CursorBlock);
  263.   EosLn;
  264.   QwriteEos (SameAttr,'MODIFY           MASK  MODE');
  265.   Qwrite (succ(EosR),1,SameAttr,'-------------   ----- -----');
  266.   EosLn;
  267.   DisplayModCursor ('Off           = ',CursorOff);
  268.   DisplayModCursor ('On